perm filename CODE[C,JRA] blob sn#014368 filedate 1972-11-22 generic text, type T, neo UTF8
00100	(IF-NEEDED C-F-AND (CODE-FOR (AND . !'L) !<CODE)
00200	   (CSETQ CODE NIL)
00300	   (FOR-EACH-ELEMENT G L
00400	      (CSETQ CODE (CONS !"(PROG (ACHIEVE ,G) (PROTECT ,G)) CODE)))
00500	   (CSETQ CODE !"(PROG "AUX" ((PROTECTEDS PROTECTEDS))
00600	                      !@(REVERSE ,CODE)))
00700	   (PUTP CODE 'UNORDERED 'CHOICE)
00800	   (NOTE))
00900	
01000	(IF-NEEDED C-F-NOT-EXISTS
01100	   (CODE-FOR (NOT (EXISTS !>V !'G))
01200	      (PROG "AUX" !,V
01300	          :LP (COND ((FIND !,V !<G1) (MAKE (NOT !<G2)) (GO 'LP)))
01400	              'OK))
01500	   (CSETQ G1 (PREFIX '/!/; V G)
01600	          G2 (PREFIX '/!/, V G))
01700	   (NOTE))
01800	
01900	(IF-NEEDED C-F-EXISTS (CODE-FOR (EXISTS !>V !'G) !<CODE)
02000	   "AUX"((G1 (PREFIX '/!/; V G)))
02100	   (CSETQ CODE
02200	      !"(PROG "AUX" ,V
02300	            !@(COND ((EQ (CAR ,REASON) 'ACHIEVE)
02400	                     !"((IF ,G1 (RETURN 'ALREADY-TRUE)))))
02500	            (CHOOSE ,G1)
02600	            (MAKE @(PREFIX '/!/, ,V ,G))))
02700	   (NOTE))  
02800	
02900	(IF-NEEDED C-F-WHERE (CODE-FOR (WHERE !'G !'Q) !<CODE)
03000	   (CSETQ CODE (LIST (CAR REASON) G))
03100	   (NOTE))
03200	
03300	(IF-NEEDED C-F-NOT-WHERE (CODE-FOR (NOT (WHERE !'G !'Q)) !<CODE)
03400	   (CSETQ CODE (LIST (CAR REASON) (LIST 'NOT G)))
03500	   (NOTE))
03600	
03700	(IF-NEEDED M-O-NOT (MEANING-OF (NOT !'G) !<MEAN)
03800	   (COND ((TRY-NEXT (FETCHM !"(MEANING-OF ,G !>MEAN)))
03900	          (CSETQ MEAN (LIST 'NOT MEAN))
04000	(NOTE))))